#!/usr/bin/perl

use Socket;
use IO::Select;

$bindport=9000;

$server='127.0.0.1';
$remoteport=32000;


sub alarma {
        print stderr "server down $server:$rport\n";
        while(1) {
                local $|=1;
                print "\a\a\a\a\a\a\a\a\a\a\a";
                select undef, undef, undef, 0.25;
        }
}

socket SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp') or die;
setsockopt SOCK, SOL_SOCKET, SO_REUSEADDR, pack("l", 1); 
bind SOCK, sockaddr_in($bindport, INADDR_ANY) or die;
listen SOCK, SOMAXCONN;
while(accept CLIENT, SOCK) {
	if(!defined($pid = fork())) {
		die "cannot fork\n";
	} elsif($pid) {
		next;
	} else {
		($cport, $caddr) = sockaddr_in(getpeername(CLIENT));
		$caddr = inet_ntoa($caddr);

		socket SOCK2, PF_INET, SOCK_STREAM, getprotobyname('tcp') or alarma();
		connect SOCK2, sockaddr_in($remoteport, inet_aton($server)) or alarma();
		binmode CLIENT;
		binmode SOCK2;
		$cr = IO::Select->new();
		$cr->add(\*CLIENT);
		$sr = IO::Select->new();
		$sr->add(\*SOCK2);
		while(1) {
			if($cr->can_read(0)) {
    				recv CLIENT, $_, 1000000, 0;
				goto DONE if length$_ == 0;
				send SOCK2, $_, 0;
				print "--------------------------($caddr:$cport)>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>\n$_--------------------------($caddr:$cport)>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>\n";
			}
			if($sr->can_read(0)) {
    				recv SOCK2, $_, 1000000, 0;
				goto DONE if length$_ == 0;
				send CLIENT, $_, 0;
				print "<<<<<<<<<<<<<<<<<<<<<<<<<<($caddr:$cport)--------------------------------\n$_<<<<<<<<<<<<<<<<<<<<<<<<<<($caddr:$cport)--------------------------------\n";
			}
		}
		DONE:
			shutdown CLIENT, 2;
			shutdown SOCK2, 2;
			exit;
	}
}
